subroutine rgp_fortran_build_vbia( &
       no, & ! (in)    number of occupied orbitals
       nv, & ! (in)    number of unoccupied orbitals
      Bkl, & ! (in)    inverse matrix
      Via, & ! (in)    new rows
     VBia)   ! (out)   contraction of B and V

implicit none

integer,      intent(in)    ::     no
integer,      intent(in)    ::     nv
real(kind=8), intent(in)    ::    Bkl(no,no)
real(kind=8), intent(in)    ::    Via(no,nv) ! second index labels which row
real(kind=8), intent(out)   ::   VBia(no,nv) ! second index labels which row

real(kind=8) :: x

integer :: a
integer :: i
integer :: j

do a = 1,nv
do i = 1,no
  x = 0.00d+00
  do j = 1,no
    x = x + Via(j,a) * Bkl(j,i)
  enddo
   VBia(i,a) = x
enddo
enddo

end subroutine rgp_fortran_build_vbia




subroutine rgp_fortran_build_tvbjb( &
       no, & ! (in)    number of occupied orbitals
       nv, & ! (in)    number of unoccupied orbitals
    Tiajb, & ! (in)    two electron integrals in 1122 order
     VBia, & ! (in)    contraction of B and V
    TVBjb)   ! (out)   contraction of T, V, and B

implicit none

integer,      intent(in)    ::     no
integer,      intent(in)    ::     nv
real(kind=8), intent(in)    ::  Tiajb(no,nv,no,nv)
real(kind=8), intent(in)    ::   VBia(no,nv) ! second index labels which row
real(kind=8), intent(out)   ::  TVBjb(no,nv)

real(kind=8) :: x

integer :: a
integer :: b
integer :: i
integer :: j

do b = 1,nv
do j = 1,no
  x = 0.00d+00
  do a = 1,nv
  do i = 1,no
    x = x + VBia(i,a) * Tiajb(i,a,j,b)
  enddo
  enddo
  TVBjb(j,b) = x
enddo
enddo

end subroutine rgp_fortran_build_tvbjb




subroutine rgp_fortran_build_tbuia( &
       no, & ! (in)    number of occupied orbitals
       nv, & ! (in)    number of unoccupied orbitals
    Tiajb, & ! (in)    two electron integrals in 1122 order
     BUjb, & ! (in)    contraction of B and V
    TBUia)   ! (out)   contraction of T, B, and U

implicit none

integer,      intent(in)    ::     no
integer,      intent(in)    ::     nv
real(kind=8), intent(in)    ::  Tiajb(no,nv,no,nv)
real(kind=8), intent(in)    ::   BUjb(no,nv) ! second index labels which row
real(kind=8), intent(out)   ::  TBUia(no,nv)

real(kind=8) :: x

integer :: a
integer :: b
integer :: i
integer :: j

TBUia = 0.00d+00
do b = 1,nv
do j = 1,no
  x = BUjb(j,b)
  do a = 1,nv
  do i = 1,no
    TBUia(i,a) = TBUia(i,a) + x * Tiajb(i,a,j,b)
  enddo
  enddo
enddo
enddo

end subroutine rgp_fortran_build_tbuia




subroutine rgp_fortran_build_tvbaj_aaaa( &
       no, & ! (in)    number of occupied orbitals
       nv, & ! (in)    number of unoccupied orbitals
    Tiajb, & ! (in)    two electron integrals in 1122 order
     VBia, & ! (in)    contraction of B and V
    TVBaj)   ! (out)   contraction of T, V, and B

implicit none

integer,      intent(in)    ::     no
integer,      intent(in)    ::     nv
real(kind=8), intent(in)    ::  Tiajb(no,nv,no,nv)
real(kind=8), intent(in)    ::   VBia(no,nv) ! second index labels which row
real(kind=8), intent(out)   ::  TVBaj(nv,no)

real(kind=8) :: x

integer :: a
integer :: b
integer :: i
integer :: j

TVBaj = 0.00d+00
do b = 1,nv
do j = 1,no
do a = 1,nv
  x = 0.00d+00
  do i = 1,no
    x = x + Tiajb(i,a,j,b) * VBia(i,b)
  enddo
  TVBaj(a,j) = TVBaj(a,j) + x
enddo
enddo
enddo

end subroutine rgp_fortran_build_tvbaj_aaaa




subroutine rgp_fortran_build_tbab_aabb( &
       no, & ! (in)    number of occupied orbitals
       nv, & ! (in)    number of unoccupied orbitals
    Tiajb, & ! (in)    two electron integrals in 1122 order
      Blk, & ! (in)    transpose of inverse matrix (indices are alpha beta)
     TBab)   ! (out)   contraction of tei and inverse

implicit none

integer,      intent(in)    ::     no
integer,      intent(in)    ::     nv
real(kind=8), intent(in)    ::  Tiajb(no,nv,no,nv)
real(kind=8), intent(in)    ::    Blk(no,no) ! alpha beta
real(kind=8), intent(out)   ::   TBab(nv,nv)

integer :: i, a, j, b

TBab = 0.00d+00
do b = 1,nv
do j = 1,no
do a = 1,nv
do i = 1,no
  TBab(a,b) = TBab(a,b) + Tiajb(i,a,j,b) * Blk(i,j)
enddo
enddo
enddo
enddo

end subroutine rgp_fortran_build_tbab_aabb




subroutine rgp_fortran_build_vbuab_aabb( &
       no, & ! (in)    number of occupied orbitals
       nv, & ! (in)    number of unoccupied orbitals
      Via, & ! (in)    new rows
     BUjb, & ! (in)    contraction of new cols with inverse
    VBUab)   ! (out)   contraction of new rows, new cols, and inverse

implicit none

integer,      intent(in)    ::     no
integer,      intent(in)    ::     nv
real(kind=8), intent(in)    ::    Via(no,nv) ! second index labels which row
real(kind=8), intent(in)    ::   BUjb(no,nv) ! second index labels which col
real(kind=8), intent(out)   ::  VBUab(nv,nv)

real(kind=8) :: x

integer :: k, a, b

do b = 1,nv
do a = 1,nv
  x = 0.00d+00
  do k = 1,no
    x = x + Via(k,a) * BUjb(k,b)
  enddo
  VBUab(a,b) = VBUab(a,b) + x
enddo
enddo

end subroutine rgp_fortran_build_vbuab_aabb
